home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / teglp.zip / SAMPROGS.ZIP / HTEST03.PAS < prev    next >
Pascal/Delphi Source File  |  1990-05-31  |  2KB  |  88 lines
  1.  
  2. USES
  3.     crt,
  4.     graph,
  5.     TEGLIntr,
  6.     FastGrph;
  7.  
  8. const
  9.   TEGLBackPattern    : FillPatternType = ($AA,$55,$AA,$55,$AA,$55,$AA,$55);
  10.  
  11. var
  12.   ch : char;
  13.   i  : word;
  14.  
  15. procedure waitforkey;
  16.    begin
  17.       while keypressed do ch:=readkey;
  18.       while not keypressed do;
  19.       while keypressed do ch:=readkey;
  20.    end;
  21.  
  22. procedure fastrectangle(x,y,x1,y1:word);
  23.    var c:word;
  24.    begin
  25.       c := getcolor;
  26.       fastline(x,y,x1,y,c);
  27.       fastline(x,y,x,y1,c);
  28.       fastline(x,y1,x1,y1,c);
  29.       fastline(x1,y,x1,y1,c);
  30.    end;
  31.  
  32. procedure hpixline(x,y,x1:word);
  33.    var i,c:word;
  34.    begin
  35.       c := getcolor;
  36.       for i:=x to x1 do
  37.      putpixs(i,y,c);
  38.    end;
  39.  
  40. procedure vpixline(x,y,y1:word);
  41.    var i,c:word;
  42.    begin
  43.       c := getcolor;
  44.       for i:=y to y1 do
  45.      putpixs(x,i,c);
  46.    end;
  47.  
  48. procedure Pixrectangle(x,y,x1,y1:word);
  49.    begin
  50.       hpixline(x,y,x1);
  51.       vpixline(x,y,y1);
  52.       hpixline(x,y1,x1);
  53.       vpixline(x1,y,y1);
  54.    end;
  55.  
  56. begin
  57.    Herc720x348x2;
  58.    Init_TEGLIntr;
  59.    setmouseminmax(0,0,getmaxx,getmaxy);
  60.  
  61.    randomize;
  62.  
  63.    setcolor(white);
  64.    pixrectangle(0,0,719,347);
  65.    pixrectangle(5,5,714,342);
  66.    pixrectangle(10,10,709,338);
  67.  
  68.    while keypressed do ch:=readkey;
  69.    while not keypressed do
  70.       begin
  71.      putpixs(random(720),random(348),white);
  72.      putpixs(random(720),random(348),black);
  73.       end;
  74.  
  75.    putpixs(5,5,white);
  76.    i := getpixs(5,5);
  77.    if i<>1 then
  78.       abort('The value is not 1');
  79.  
  80.    putpixs(5,5,black);
  81.    i := getpixs(5,5);
  82.    if i<>0 then
  83.       abort('The value is not 0');
  84.  
  85.    showmouse;
  86.    waitforkey;
  87. end.
  88.